The ‘rangl’ package illustrates some generalizations of GIS-y and topology tasks in R with “tables”. See the package project for more information.
Get some maps and plot in 3D - in plane view, or globe view.
NOTE: these plots are interactive, but performance and quality will be better (for now) if run locally.
library(rgl)
library(maptools)
data(wrld_simpl)
library(raster)
## convert to triangles and plot
library(rangl)
cmesh <- rangl(wrld_simpl)
plot(cmesh)
#> Joining, by = "object_"
#> Joining, by = "triangle_"You must enable Javascript to view this page properly.
sids <- raster::shapefile(system.file("shapes/sids.shp", package="maptools"))
#> Warning in .local(x, ...): .prj file is missing
projection(sids) <- "+proj=longlat +ellps=clrk66"
ex <- extent(sids) + 5
gl <- graticule::graticule(seq(xmin(ex), xmax(ex), length = 15),
seq(ymin(ex), ymax(ex), length = 8))
## convert to triangles, but wrap onto globe then plot
smesh <- rangl(sids)
plot(globe(smesh))
#> Joining, by = "object_"
#> Joining, by = "triangle_"
mgl <- rangl(gl)
#> Joining, by = "segment_"
#> Joining, by = "segment_"
mgl$o$color_ <- "black"
plot(globe(mgl), lwd = 2)
#> Joining, by = "object_"
#> Joining, by = "segment_"You must enable Javascript to view this page properly.
It’s trivial to have “holes”, because there are no holes, because we have a true surface, composed of 2D primitives (triangles).
library(spbabel)
data(holey)
## SpatialPolygonsDataFrame
sph <- sp(holey)
glh <- rangl(sph)
plot(glh)
#> Joining, by = "object_"
#> Joining, by = "triangle_"You must enable Javascript to view this page properly.
linehouse <- as(sph, "SpatialLinesDataFrame")
plot(rangl(linehouse))
#> Joining, by = "segment_"
#> Joining, by = "segment_"
#> Joining, by = "object_"
#> Joining, by = "segment_"You must enable Javascript to view this page properly.
lmesh <- rangl(as(wrld_simpl, "SpatialLinesDataFrame"))
#> Joining, by = "segment_"
#> Joining, by = "segment_"
plot(globe(lmesh))
#> Joining, by = "object_"
#> Joining, by = "segment_"
#> Warning in matrix(vindex$row_n, ncol = 2, byrow = TRUE): data length [39045] is not a sub-multiple or multiple
#> of the number of rows [19523]You must enable Javascript to view this page properly.
Rgl mesh3d objects that use “triangle” primitives are supported.
library(rgl)
dod <- rangl(dodecahedron3d(col = "cyan"))
octo <- rangl(translate3d(octahedron3d(col = "blue"), 6, 0, 0))
plot(dod, col = viridis::viridis(5)[1], alpha = 0.3)
#> Joining, by = "object_"
#> Joining, by = "triangle_"
plot(octo, col = viridis::viridis(5)[5], alpha = 0.3)
#> Joining, by = "object_"
#> Joining, by = "triangle_"
bg3d("grey")You must enable Javascript to view this page properly.
To complete the support for these rgl objects we need quads, and to allows a mix of quads and triangles in one data set (that’s what extrude3d uses). Extrusion is a bit limiting so it’s unclear how useful this is (yes it is common, though). See rgl::extrude3d for the most readily available method in R.
And points work! (Don’t laugh).
library(rangl)
library(maptools)
data(wrld_simpl)
mpts <- as(as(wrld_simpl, "SpatialLinesDataFrame"), "SpatialMultiPointsDataFrame")
plot(rangl(mpts))
#> Joining, by = "object_"
#> Joining, by = "branch_"
rgl::view3d(theta = 25, phi = 3)You must enable Javascript to view this page properly.
The trip package includes a ‘walrus818’ data set courtesy of Anthony Fischbach. Zoom around and see if you can find them.
library(trip)
library(rangl)
data(walrus818)
library(graticule)
prj <-"+proj=laea +lon_0=0 +lat_0=90 +ellps=WGS84"
gr <- graticule(lats = seq(40, 85, by = 5), ylim = c(35, 89.5), proj = prj)
library(maptools)
data(wrld_simpl)
w <- spTransform(subset(wrld_simpl, coordinates(wrld_simpl)[,2] > -70), prj)
library(graticule)
walrus <- spTransform(walrus818, prj)
gr$color_ <- "black"
rgl::par3d(windowRect = c(100, 100, 912 + 100, 912 +100))
plot(rangl(gr))
#> Joining, by = "segment_"
#> Joining, by = "segment_"
#> Joining, by = "object_"
#> Joining, by = "segment_"
#> Warning in matrix(vindex$row_n, ncol = 2, byrow = TRUE): data length [3819] is not a sub-multiple or multiple of
#> the number of rows [1910]
w$color_ <- sample(viridis::inferno(nrow(w)))
plot(rangl(w), specular = "black")
#> Joining, by = "object_"
#> Joining, by = "triangle_"
plot(rangl(walrus))
#> Joining, by = "object_"
#> Joining, by = "segment_"
um <- structure(c(0.934230506420135, 0.343760699033737, 0.0950899347662926,
0, -0.302941381931305, 0.905495941638947, -0.297159105539322,
0, -0.188255190849304, 0.24880850315094, 0.950081348419189, 0,
0, 0, 0, 1), .Dim = c(4L, 4L))
par3d(userMatrix = um)You must enable Javascript to view this page properly.